unit gm_patterns;

interface

uses
  gm_engine, SysUtils, uDatFile, XML;

type
  TPattern = class
    Name      : string;
    Title     : string;
    pType     : string;
    Next      : TPattern;
    Tex       : TTexture;
    Offset    : TPoint;
    Frame     : TPoint;
  end;

type
  TGroundPat = class(TPattern);


type
  TObjPat = class(TPattern)
    Color     : Integer;
    IsWall    : Boolean;
    BlockWalk : Boolean;
    BlockLook : Boolean;
    Container : Boolean;
  end;

type
  TCrPat = class(TPattern)
    Health    : Integer;
    Mana      : Integer;
    ParamValue: array of Integer;
    ParamsCnt : Integer;
    Exp       : Integer;
  end;

type
  TDamage = record
    Min, Max  : Integer;
  end;

type
  TItemPat = class(TPattern)
    CanGroup  : Boolean;
    Equip     : string;
    Cls       : string;
    AllowedSuf: string;
    AllowedMat: string;
    EquipTex  : TTexture;
    Gender    : Integer;
    EffectTag : Integer;
    Damage    : TDamage;
    Defense   : Integer;
    Block     : Integer;
    Durability: Integer;
    Chance    : Integer;
    MinCount  : Integer;
    MaxCount  : Integer;
    Throw     : Boolean;
    Mana      : Integer;
    Pot       : Boolean;
    Scr       : Boolean;
    Rot       : Boolean;
    FlyAng    : Boolean;
    Sword     : Boolean;
    Axe       : Boolean;
    Bow       : Boolean;
    Arrow     : Boolean;
    Shield    : Boolean;
    Rock      : Boolean;
  end;

type
  TSuffixPat = class(TPattern)
    Rarity    : Integer;
    Strength  : Integer;
  end;

type
  TMaterialPat = class(TPattern)
    Rarity    : Integer;
    Title1    : string;
    Title2    : string;
    Title3    : string;
    Title4    : string;
    Durability: Integer;
  end;

var
  Patterns: TPattern;
  AllItemsID: string = '';

function GetPattern(pType, Name: string): TPattern;
procedure Load(FileName: string);
procedure Init(PatDir: string);
procedure Free;

implementation

uses gm_item, Stat, Utils;

function GetPattern(pType, Name: string): TPattern;
begin
  pType   := UpperCase(pType);
  Name    := UpperCase(Name);
  Result  := Patterns;
  while (Result <> nil) do
  begin
    if (Result.pType = pType) and (Result.Name = Name) then Exit;
    Result := Result.Next;
  end;
end;

procedure Load(FileName: string);
var
  Dat       : TDat;
  Pat       : TPattern;
  S, FDir, D: string;
  i         : Integer;
  E         : TExplodeResult;
begin
  E := nil;
  dat := TDat.Create;
  dat.LoadFromFile(FileName);

  Pat := nil;
  if (UpperCase(dat.Param('Type').Str('')) = 'GROUND'  ) then Pat := TGroundPat.Create;
  if (UpperCase(dat.Param('Type').Str('')) = 'OBJECT'  ) then Pat := TObjPat.Create;
  if (UpperCase(dat.Param('Type').Str('')) = 'CREATURE') then Pat := TCrPat.Create;
  if (UpperCase(dat.Param('Type').Str('')) = 'ITEM'    ) then Pat := TItemPat.Create;
  if (UpperCase(dat.Param('Type').Str('')) = 'SUFFIX'  ) then Pat := TSuffixPat.Create;
  if (UpperCase(dat.Param('Type').Str('')) = 'MATERIAL') then Pat := TMaterialPat.Create;

  if Pat = nil then
  begin
    Dat.Free;
    Exit;
  end;

  Pat.pType     := UpperCase(dat.Param('Type').Str(''));
  Pat.Name      := GetFileName(FileName);
  Pat.Title     := dat.Param('Title').Str(Pat.Name);
  Pat.Name      := UpperCase(dat.Param('Name').Str(Pat.Name));
  Pat.Next      := Patterns;
  Patterns      := Pat;

  fdir := GetDirectory(FileName);

  with Pat do
  begin
    S := dat.Param('Texture').Str('');
    if (S = '') then S := dat.Param('Sprite').Str('');
    Tex := LoadTexture(fdir + S);

    Offset.X := dat.Param('OffsetX').Int(0);
    Offset.Y := dat.Param('OffsetY').Int(0);
    Frame.X := dat.Param('FramesWidth').Int(32);
    Frame.Y := dat.Param('FramesHeight').Int(32);

    if (Frame.X <> 0) and (Frame.Y <> 0) then SetFrameSize(Tex, Frame.X, Frame.Y);
  end;

  if Pat.pType = 'GROUND' then
    with TGroundPat(Pat) do
    begin

    end;

  if Pat.pType = 'OBJECT' then
    with TObjPat(Pat) do
    begin
      Color := dat.Param('Color').Int($00FFFFFF);
      IsWall := dat.Param('Wall').Bool(False);
      if IsWall then BlockWalk := True;
      if IsWall then BlockLook := True;
      BlockWalk := dat.Param('BlockWalk').Bool(BlockWalk);
      BlockLook := dat.Param('BlockLook').Bool(BlockLook);
      Container := dat.Param('Container').Bool(False);
    end;

  if Pat.pType = 'CREATURE' then
    with TCrPat(Pat) do
    begin
//      Frame.X   := dat.Param('FramesWidth').Int(0);
//      Frame.Y   := dat.Param('FramesHeight').Int(0);
      Health    := dat.Param('Health').Int(50);
      Mana      := dat.Param('Mana').Int(10);
      Exp       := dat.Param('Exp').Int(1);
      SetLength(ParamValue, CrStatsCnt);
      for i := 0 to CrStatsCnt - 1 do
        if i < 4 then ParamValue[i] := dat.Param(CrStats[i].Name).Int(4)
          else ParamValue[i] := dat.Param(CrStats[i].Name).Int(0);
    end;

  if Pat.pType = 'ITEM' then
    with TItemPat(Pat) do  
    begin
      AllItemsID := AllItemsID + Name + ',';
      Pot        := dat.Param('Potion').Bool(False);
      Scr        := dat.Param('Scroll').Bool(False);
      EffectTag  := dat.Param('EffectTag').Int(0);
      if (EffectTag > 0) then
      begin
        S := '';
        if Pot then S := AnsiLowerCase(Elixir.GetColorName(EffectTag).En) + '.png';
        if Scr then S := AnsiLowerCase(Scroll.GetColorName(EffectTag).En) + '.png';
        Tex := LoadTexture(fdir + S);
      end;
      Mana       := dat.Param('Mana').Int(0);
      Chance     := dat.Param('Rarity').Int(0);
      Gender     := dat.Param('Gender').Int(1);
      MinCount   := dat.Param('MinCount').Int(1);
      MaxCount   := dat.Param('MaxCount').Int(1);
      CanGroup   := dat.Param('CanGroup').Bool(False);
      if Pot or Scr then CanGroup := True;
      Equip      := UpperCase(dat.Param('Equip').Str(''));
      Cls        := UpperCase(dat.Param('Class').Str(''));
      AllowedSuf := UpperCase(dat.Param('AllowedSuffixes').Str(''));
      AllowedMat := UpperCase(dat.Param('AllowedMaterials').Str(''));
      Durability := dat.Param('Durability').Int(0);
      if CanGroup then
      begin
        AllowedSuf := '';
        AllowedMat := '';
        Durability := 0;
      end;
      if Pot then Equip := 'RHAND';
      D          := dat.Param('Damage').Str('0-0');
      E := Explode('-', D);
      Damage.Min := StrToInt(E[0]);
      if (High(E) > 0) then
        Damage.Max := StrToInt(E[1])
          else Damage.Max := Damage.Min;
      Defense    := dat.Param('Defense').Int(0);
      Block      := dat.Param('Block').Int(0);
      Throw      := dat.Param('Throw').Bool(False);
      if Pot then Throw := True;
      Rot        := dat.Param('Rotate').Bool(False);
      if Pot then Rot := True;
      FlyAng     := dat.Param('FlyAng').Bool(False);
      
      Sword      := dat.Param('Sword').Bool(False);
      Axe        := dat.Param('Axe').Bool(False);
      Bow        := dat.Param('Bow').Bool(False);
      Arrow      := dat.Param('Arrow').Bool(False);
      Shield     := dat.Param('Shield').Bool(False);
      Rock       := dat.Param('Rock').Bool(False);
    end;

  if Pat.pType = 'SUFFIX' then
    with TSuffixPat(Pat) do
    begin
      Rarity     := dat.Param('Rarity').Int(0);
    end;

  if Pat.pType = 'MATERIAL' then
    with TMaterialPat(Pat) do
    begin
      Rarity     := dat.Param('Rarity').Int(0);
      Durability := dat.Param('Durability').Int(0);
      Title1 := dat.Param('Title1').Str('');
      Title2 := dat.Param('Title2').Str('');
      Title3 := dat.Param('Title3').Str('');
      Title4 := dat.Param('Title4').Str('');
    end;

  dat.Free;
end;

procedure Init(PatDir: String);
var
  SR: TSearchRec;
begin
  if (PatDir <> '') then
    if (PatDir[Length(PatDir)] <> '\') then PatDir := PatDir + '\';
  if FindFirst(PatDir + '*.*', faAnyFile, SR) = 0 then
    repeat
      if (SR.Name = '.') or (SR.Name = '..') then Continue;
      if (SR.Attr and faDirectory) <> 0 then Init(PatDir + SR.Name)
        else if UpperCase(GetFileExt(SR.Name)) = 'DAT' then Load(PatDir + SR.Name);
    until (FindNext(SR) <> 0);
  FindClose(SR);
end;

procedure Free;
var
  p, pn : TPattern;
begin
  p := Patterns;
  while (p <> nil) do
  begin
    pn := p.Next;
    p.Free;
    p := pn;
  end;
  Patterns := nil;
end;

end.

